            BOI.4. (Petrecere). Imaginai-v[ c[ luai parte la o serat[ la care
particip[ cel mult 500 persoane. Gazda i invit[ pe toi la cin[. In sufragerie
exist[ mai multe mese. Invitaii se aeaz[ la mas[ n felul urm[tor: fiecare
persoan[ care nu st[ singur[ la mas[ trebuie s[ cunoasc[ cel puin o persoan[
de la masa respectiv[. Se presupune c[ dac[ o persoan[ o cunoate pe a doua,
atunci i a doua o cunoate pe prima.
           Aezarea la mas[ nu este nsoit[ de prezent[ri. Drept urmare, dac[ dou[
persoane situate la aceeai mas[ nu se cunoteau iniial, ele nu se vor cunoate nici
dup[ aezarea la mas[.
a) Determinai num[rul minim de mese necesare i persoanele care sunt aezate la
fiecare mas[.
           La fiecare mas[ exist[ o singur[ persoan[ care va vorbi cu chelnerul;
aceast[ persoan[ este numit[ liderul mesei. Fiecare persoan[ transmite tuturor
persoanelor cunoscute situate la mas[, opiunea sa privind meniul. Timpul necesar
fiec[rei persoane de a transmite opiunea sa tuturor persoanelor pe care le cunoate
este constant[ i aceeai pentru fiecare persoan[.
b) Determinai pentru fiecare mas[ persoana cea mai indicat[ ca lider, astfel nct
aceasta s[ primeasc[ opiunile n timp minim; listai pentru fiecare mas[ liderul
ales i timpul corespunz[tor.
           Dup[ servirea cinei, gazda dorete s[ uneasc[ mesele. In acest scop, ea
cheam[ civa prieteni. Fiecare dintre acetia, la sosirea sa, este prezentat liderilor
a dou[ mese, dup[ care mesele sunt unite formnd o nou[ mas[.
c) Care este ordinea de unire a meselor astfel nct n final toate mesele s[ fie unite
ntr-una singur[ iar condiiile de la punctul (b) s[ r[mn[ satisf[cute ? Specificai
timpul minim necesar liderului mesei finale pentru a primi informaii de la toate
celelalte persoane.
           Dup[ unirea meselor, prietenii gazdei se retrag i mesele i recap[t[ struc-
tura dinainte de unire, pn[ la terminarea seratei. Cnd petrecerea se termin[,
persoanele ncep s[ p[r[seasc[ mesele.
d) Determinai, pentru fiecare mas[, num[rul minim de persoane i ordinea n care
acestea p[r[sesc masa, pn[ cnd persoanele care au r[mas la mas[ s[ nu se
cunoasc[ ntre ele.
Exemplu: S[ presupunem c[ num[rul persoanelor este 8 i c[:
- persoana 1 cunoate persoanele 2 i 3;
- persoana 2 cunoate persoanele 1 i 4;
- persoana 3 cunoate persoanele 1 i 4;
- persoana 4 cunoate persoanele 2 i 3;
- persoana 5 cunoate persoana 6;
- persoana 6 cunoate persoanele 5 i 7;
- persoana 7 cunoate persoana 6;
- persoana 8 nu cunoate nici o alt[ persoan[;
Un set corect de date are forma:
8
1  2
1  3
2  4
7  6
4  3
5  6
0  0
O ieire corect[ are forma:
  a)
3 mese
Masa 1: 1 2 3 4
Masa 2: 5 6 7
Masa 3: 8
  b)
Lideri:
Masa 1: 2; timp=2
Masa 2: 6; timp=1
Masa 3: 8; timp=0
  c)
6  8 Noul lider: 9
2  9 Noul lider: 10
Timp=3
  d)
Persoanele care pleac[:
Masa 1: 2  3
Masa 2: 6
Masa 3:
============================================
          BOI 4 (Vlad Atanasiu):
uses crt;
type pers_l=^persoana;
     persoana=record
                    cod:integer;
                    urm:pers_l;
              end;
     masa_l=^masa;
     masa=record
                lista:pers_l;
                urm:masa_l;
                nr_pers:integer;
          end;
     pereche_l=^pereche;
     pereche=record
             cod1,cod2:integer;
             urm:pereche_l;
             end;
var start,curent:masa_l;
  p_start,p_curent,c_start,c_curent,p_pastreaza:pereche_l;
{ Vor exista doua liste de perechi. A doua lista (c) va folosi
la pastrarea legaturilor care se taie pentru a evita formarea
ciclurilor. Inainte de punctul d) aceasta lista se adauga la
cealalta deoarece va fi necesara cunosterea tuturor legaturilor
pentru rezolvarea acelui punct }
    ciclu,necunoscuti:boolean;
    a,b,min_timp,nr_mese,maxim:integer;
---------------------------------------------------------
function cauta(cod:integer;m:masa_l):boolean;
{intoarce True daca persoana cod se afla la masa m}
var gasit:boolean;
    p:pers_l;
begin
   gasit:=false;
   p:=m^.lista;
   while (p<>nil) and not gasit do
      begin
        if p^.cod=cod then gasit:=true;
        p:=p^.urm;
      end;
   cauta:=gasit;
end;
---------------------------------------------------------
procedure insereaza_unul(var m:masa_l;cod:integer);
{ insereaza persoana cod la masa m }
var p:pers_l;
begin
   p:=m^.lista; new(m^.lista); 
   m^.lista^.cod:=cod; m^.lista^.urm:=p;
   inc(m^.nr_pers);
end;
---------------------------------------------------------
procedure concat(var m1,m2:masa_l);
{ concateneaza mesele m1 si m2 si sterge masa m2 }
var p:pers_l;
    m:masa_l;
begin
   p:=m1^.lista;
   while p^.urm<>nil do p:=p^.urm;
   p^.urm:=m2^.lista;m1^.nr_pers:=m1^.nr_pers+m2^.nr_pers;
   m:=start;
   if m<>m2 then begin
       while m^.urm<>m2 do m:=m^.urm;
       m^.urm:=m2^.urm;
                 end
            else start:=m2^.urm;
   dispose(m2);
end;
---------------------------------------------------------
procedure insereaza(cod1,cod2:integer;unul:boolean);
{ insereaza una sau doua persoane la mese }
var p:pers_l;
    masa1,masa2:masa_l;
begin
   if unul then
{daca este doar o persoana, se creeaza o masa pentru ea}
     begin
       curent:=start; new(start);
       start^.nr_pers:=0; start^.lista:=nil;
       insereaza_unul(start,cod1); 
{persoana este pusa la acea masa}
       start^.urm:=curent;
     end
           else begin
       curent:=start;
       masa1:=nil; 
{masa la care va fi gasita persoana cu codul 1 }
       masa2:=nil; 
{ masa la care va fi gasita persoana cu codul 2 }
       while curent<>nil do begin
           if cauta(cod1,curent) then masa1:=curent;
           if cauta(cod2,curent) then masa2:=curent;
           curent:=curent^.urm;
         end;
      if (masa1<>nil) and (masa2=nil) then 
{ daca primul are masa si al doilea nu }
        insereaza_unul(masa1,cod2) 
{ este pus si al doilea la masa primului }
                                     else 
      if (masa1=nil) and (masa2<>nil) then 
{ daca invers }
        insereaza_unul(masa2,cod1) 
{ este pus primul la masa celuilalt}
                                      else 
         if (masa1=nil) and (masa2=nil) then 
{ daca nici unul nu e la vreo masa }
            begin
              curent:=start; { se creeaza o masa noua }
              new(start);
              start^.nr_pers:=0; start^.lista:=nil;
              insereaza_unul(start,cod1); 
{ si sunt puse la acea masa ambele persoane }
     insereaza_unul(start,cod2); start^.urm:=curent;
            end
                                        else 
{ daca amandoi se afla la cate o masa }
           if masa1<>masa2 then 
{ se actioneaza doar daca sunt la mese diferite }
              concat(masa1,masa2) 
{ se concateneaza mesele intr-una singura }
                           else
                begin
                   ciclu:=true; 
{ daca ambele persoane exista la aceeasi masa, se semnaleaza ca
exista ciclu si legatura este pusa la lista de legaturi care
formeaza ciclu}
                c_curent:=c_start; new(c_start);
                c_start^.cod1:=cod1; c_start^.cod 2:=cod2;
                c_start^.urm:=c_curent;
                end;
             end;
end;
---------------------------------------------------------
procedure afiseaza_masa(m:masa_l);
{ afiseaza persoanele de la masa m }
var p:pers_l;
begin
   p:=m^.lista; write(m^.nr_pers,' persoane : ');
   while p<>nil do begin
        write(p^.cod,' '); p:=p^.urm;
                   end;
end;
---------------------------------------------------------
procedure citeste;
{ citeste datele din fisierul de intrare. Persoanele le adauga
la mese, si unple listele de legaturi p si c (legaturile care
se taie pentru a nu forma cicluri }
var t:text;
    cod1,cod2:integer;
    unul:boolean;
begin
   assign(t,'input49'); reset(t);
   while not eof(t) do begin
        ciclu:=false; unul:=true; read(t,cod1);
        if cod1>maxim then maxim:=cod1;
        p_curent:=p_start;
        if not eoln(t) then begin
             read(t,cod2);
             if cod2>maxim then maxim:=cod2;
             unul:=false;
                            end;
       insereaza(cod1,cod2,unul);
       if not ciclu then 
{daca legatura nu formeaza ciclu este pusa la lista p }
          begin
            new(p_start);
            p_start^.cod1:=cod1; p_start^.cod2:=0;
            p_start^.urm:=p_curent;
            if not unul then p_start^.cod2:=cod2;
         end;
                      end;
end;
---------------------------------------------------------
function max(i,j:integer):integer;
{ intoarce maximul a doi intregi }
begin
   if i>=j then max:=i else max:=j;
end;
---------------------------------------------------------
function lungime(cod,codn:integer):integer;
{ functie recursiva pentru aflarea timpului de comunicare al
persoanei cod. Se foloseste algoritmul clasic de aflare a
adancimii unui arbore. Variabila cond este folosita pentru a nu
se intra intr-o ciclare infinita pe aceeasi legatura.}
var lung:integer;
    pc:pereche_l;
begin
   lung:=0; pc:=p_start;
   while pc<>nil do
      begin
        if pc^.cod2<>0 then
          if (pc^.cod2=cod) and (pc^.cod1<>codn) then
            lung:=max(lung,lungime(pc^.cod1,cod)+1)
                                                 else 
            if (pc^.cod1=cod) and (pc^.cod2<>codn) then
              lung:=max(lung,lungime(pc^.cod2,cod)+1);
        pc:=pc^.urm;
      end;
   lungime:=lung;
end;
---------------------------------------------------------
function lider(m:masa_l):integer;
{ intoarce liderul mesei m, iar variabila globala min_timp va
fi actualizata la valoarea timpului de comunicare al celorlalte
persoane cu acesta }
var p:pers_l;
    x:integer;
begin
   min_timp:=500; p:=m^.lista; lider:=0;
   while p<>nil do 
{ se cauta persoana cu cel mai mic timp de comunicare de la masa
respectiva }
      begin
        x:=lungime(p^.cod,0);
        if x<min_timp then begin
            min_timp:=x; lider:=p^.cod;
                           end;
        p:=p^.urm;
      end;
end;
---------------------------------------------------------------
procedure insert_pereche
(cod,cod_prieten_1,cod_prieten_2:integer);
{insereaza legaturile cod-cod_prieten_1 si cod-cod_prieten_2 (
pentru legarea meselor) in lista p. Este exclus oricum ca aceste
legaturi sa produca cicluri.}
begin
   p_curent:=p_start; new(p_start);
   p_start^.cod1:=cod; p_start^.cod2:=cod_prieten_1; 
   new(p_start^.urm);
   p_start^.urm^.cod1:=cod;
   p_start^.urm^.cod2:=cod_prieten_2;
   p_start^.urm^.urm:=p_curent;
end;
---------------------------------------------------------
procedure ordoneaza;
{ ordoneaza mesele dupa numarul de persoane de la fiecare.
Unirea lor se va face optim in aceasta ordine. }
var m:masa_l;
    n:pers_l;
    i,j:integer;
begin
   for i:=1 to nr_mese do
      begin
         m:=start;
         while m^.urm<>nil do
            begin
              if m^.nr_pers>m^.urm^.nr_pers then
                 begin
                   n:=m^.lista; m^.lista:=m^.urm^.lista;
                   m^.urm^.lista:=n; j:=m^.nr_pers;
                   m^.nr_pers:=m^.urm^.nr_pers;
                   m^.urm^.nr_pers:=j;
                end;
             m:=m^.urm;
           end;
      end;
end;
---------------------------------------------------------
function cunoscuti(cod:integer):integer;
{ intoarce numarul de cunoscuti ai unei persoane }
var x:integer;
begin
   x:=0;
   p_curent:=p_start; { ii cauta in lista de legaturi }
   while p_curent<>nil do
      begin
      if (p_curent^.cod2<>0) and ((p_curent^.cod1=cod) or
           (p_curent^.cod2=cod)) then inc(x);
        p_curent:=p_curent^.urm;
      end;
   cunoscuti:=x;
end;
---------------------------------------------------------
function boss(m:masa_l):integer;
{determina persoana cu cei mai multi cunoscuti de la masa}
var p:pers_l;
    b,x,maxim_cunoscuti:integer;
begin
   p:=m^.lista; b:=0; maxim_cunoscuti:=0;
   while p<>nil do
      begin
        x:=cunoscuti(p^.cod);
        if maxim_cunoscuti<x then
           begin
             b:=p^.cod; maxim_cunoscuti:=x;
          end;
        p:=p^.urm;
      end;
   if maxim_cunoscuti=0 then necunoscuti:=true;
   boss:=b;
end;
---------------------------------------------------------
procedure sterge_pers(var m:masa_l;cod:integer);
{ sterge persoana cod de pe toate listele, de la masa m si
elimina toate legaturile ei din lista p }
var c:pers_l;
    p:pereche_l;
begin
   c:=m^.lista;
   while c^.cod<>cod do c:=c^.urm;
   c^.cod:=0; p:=p_start;
   while p<>nil do
      begin
        if (p^.cod1=cod) or (p^.cod2=cod) then
           begin
             p^.cod1:=0; p^.cod2:=0;
           end;
        p:=p^.urm;
      end;
end;
---------------------------------------------------------
procedure sterge_primul(var m:masa_l);
{ sterge prima persoana de la masa m; folosita la plecarea
prietenilor gazdei }
var n:pers_l;
begin
   n:=m^.lista^.urm;
   dispose(m^.lista);
   m^.lista:=n;
end;
----------------------------------------------------
begin { Programul principal }
   clrscr; maxim:=0; start:=nil;
   p_start:=nil; c_start:=nil;
   citeste;
   curent:=start; nr_mese:=0;
      while curent<>nil do
        begin
          inc(nr_mese); curent:=curent^.urm;
       end;
   ordoneaza; 
{aseaza mesele in ordinea crescatoare a numarului de persoane}
   p_curent:=p_start;
   curent:=start;
{ La punctul a) si b), afiseaza mesele cu liderii lor. }
   while curent<>nil do
      begin
        afiseaza_masa(curent);
writeln(', lider: ',lider(curent),', timp=',min_timp);
        curent:=curent^.urm;
      end;
   writeln('Sunt necesare ',nr_mese,' mese.');
   curent:=start;
   p_pastreaza:=p_start; 
{ pastreaza lista actuala de legaturi, pentru a fi restaurata
mai tarziu, dupa plecarea prietenilor gazdei }
   while curent^.urm<>nil do
      begin
        inc(maxim); 
{ prietenii gazdei sunt numerotati de la maxim+1 in sus }
        a:=lider(curent); b:=lider(curent^.urm);
        insert_pereche(maxim,a,b); 
{ insereaza legaturi intre noul venit si cei doi lideri }
        insereaza_unul(curent^.urm,maxim); 
{ insereaza noul venit la ambele mese }
        insereaza_unul(curent,maxim);
writeln(a,' ',b,' noul lider : ',lider(curent^.urm));
        curent:=curent^.urm;
      end;
   writeln('Timp: ',min_timp); curent:=start;
   while curent^.urm<>nil do
      begin
        sterge_primul(curent); 
{ reface mesele dupa plecarea prietenilor gazdei }
        sterge_primul(curent^.urm); curent:=curent^.urm;
      end;
   p_curent:=p_start;
   while p_curent<>p_pastreaza do 
{reface lista de legaturi dupaplecarea prietenilor gazdei}
      begin
        p_curent:=p_curent^.urm; dispose(p_start);
        p_start:=p_curent;
      end;
   while p_curent^.urm<>nil do p_curent:=p_curent^.urm;
   p_curent^.urm:=c_start; 
{ adauga legaturile din lista c la celelalte; sunt si cele
necesare, deoarece pentru acest punct se calculeaza numarul de
cunostinte al fiecarei persoane. }
   curent:=start; maxim:=0;
   while curent<>nil do
      begin
        necunoscuti:=false; inc(maxim);
        write('Masa ',maxim,' : ');
        repeat
           a:=boss(curent);
           if not necunoscuti then
              begin
                 sterge_pers(curent,a); 
{ se vor inlatura intotdeauna persoanele cu cei mai multi
cunoscuti }
                 write(a,' ');
              end;
        until necunoscuti; 
{ pana cand nimeni nu mai cunoaste pe nimeni la masa m }
        writeln; curent:=curent^.urm;
      end;
end.
-----------------------------------
